unit uFormBrwChromium;

{$mode objfpc}{$H+}
{$i orcis.inc}

interface

uses
    Classes, SysUtils, Controls, Forms, LCLIntf, LCLType, ExtCtrls, Buttons,
    StdCtrls, ActnList, Dialogs, LazFileUtils, FileUtil,
    {$ifdef lazcef}
    cef3types, cef3lib, cef3intf, cef3lcl, cef3own, cef_tools,
    {$endif}
    {$ifdef wacef}
    WACefTypes, WACefLib, WACefInterfaces, WACefComponent, WACefOwns,
    {$endif}
    uMessages,
    uContentBlocker, uFormBrwBase, URIParser;

type

    { TFrmBrwChromium }

    TFrmBrwChromium = class(TFrmBrwBase)
        SaveDialog: TSaveDialog;
        procedure edtAddressEnter(Sender: TObject);
    private
        FBrw: TChromium;

        // Chromium events
        // -------------------------------------------------
        procedure BrwAddressChange(Sender: TObject; const Browser: ICefBrowser;
            const Frame: ICefFrame; const url: ustring);
        procedure BrwBeforePopup(
            {$ifdef wacef}
            Sender: TObject;
            const parentBrowser: ICefBrowser;
            const frame: ICefFrame;
            var targetUrl: ustring;
            const target_frame_name: ustring;
            var popupFeatures: TCefPopupFeatures;
            var windowInfo: TCefWindowInfo;
            var client: ICefClient;
            var settings: TCefBrowserSettings;
            var no_javascript_access: boolean;
            out Result: Boolean
            {$endif}
            {$ifdef lazcef}
            Sender: TObject;
            const Browser: ICefBrowser;
            const Frame: ICefFrame;
            const targetUrl, targetFrameName: ustring;
            var popupFeatures: TCefPopupFeatures;
            var windowInfo: TCefWindowInfo;
            var client: ICefClient;
            var settings: TCefBrowserSettings;
            var noJavascriptAccess: Boolean;
            out Result: Boolean
            {$endif}
            );
        procedure BrwBeforeResourceLoad(Sender: TObject; const Browser: ICefBrowser;
            const Frame: ICefFrame; const request: ICefRequest; out Result: boolean);
        procedure BrwLoadEnd(Sender: TObject; const Browser: ICefBrowser; const Frame: ICefFrame;
            httpStatusCode: integer);
        procedure BrwLoadError(Sender: TObject; const Browser: ICefBrowser; const Frame: ICefFrame;
            errorCode: TCefErrorCode; const errorText, failedUrl: ustring);
        procedure BrwLoadStart(Sender: TObject; const Browser: ICefBrowser; const Frame: ICefFrame);
        procedure BrwStatusMessage(Sender: TObject; const Browser: ICefBrowser; const Value: ustring);
        procedure BrwTitleChange(Sender: TObject; const Browser: ICefBrowser; const ATitle: ustring);

        procedure BrwLoadingStateChange(Sender: TObject; const Browser: ICefBrowser;
            isLoading, canGoBack, canGoForward: boolean);

        procedure BrwProcessMessageReceived(Sender: TObject; const Browser: ICefBrowser;
            sourceProcess: TCefProcessId; const message: ICefProcessMessage; out Result: boolean);

        procedure BrwProtocolExecution(Sender: TObject; const Browser: ICefBrowser;
            const url: ustring; out allowOsExecution: boolean);

        procedure BrwBeforeDownload(Sender: TObject; const Browser: ICefBrowser;
            const downloadItem: ICefDownloadItem; const suggestedName: ustring;
            const callback: ICefBeforeDownloadCallback);
        procedure BrwDownloadUpdated(Sender: TObject; const Browser: ICefBrowser;
            const downloadItem: ICefDownloadItem; const callback: ICefDownloadItemCallback);

        procedure BrwMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer);
        function GetBrw: TChromium;
    protected
        procedure Init; override;
        procedure Done; override;

        procedure InitChromium;

        procedure EventTitleChange(AFrame: TWinControl; ATitle: string);

        procedure GetSource(AText: TStrings);

        property Brw: TChromium read GetBrw;
    public
        procedure LoadURL(const AUrl: string); override;

        procedure DoBack; override;
        procedure DoForward; override;
        procedure DoRefresh; override;
        procedure DoStop; override;
    end;

implementation

{$R *.lfm}

{ TFrmBrwChromium }

procedure TFrmBrwChromium.edtAddressEnter(Sender: TObject);
begin
    edtAddress.SelectAll;
end;

procedure TFrmBrwChromium.BrwAddressChange(Sender: TObject; const Browser: ICefBrowser;
    const Frame: ICefFrame; const url: ustring);
begin
    //edtAddress.Text := url;
    Log('Address changed', url);
    PostTextMessage(Self.Handle, ISM_TMP_TEXT, ISM_TMP_BRW_ADDRESS, url);
    //Application.QueueAsyncCall();
end;

procedure TFrmBrwChromium.BrwBeforePopup(Sender: TObject;
    const Browser: ICefBrowser; const Frame: ICefFrame; const targetUrl,
    targetFrameName: ustring; var popupFeatures: TCefPopupFeatures;
    var windowInfo: TCefWindowInfo; var client: ICefClient;
    var settings: TCefBrowserSettings; var noJavascriptAccess: Boolean; out
    Result: Boolean);
var
    keyShift, keyCtrl: boolean;
    msg: Cardinal;
begin
    Log('Popup', targetUrl);
    Result := True;
    keyShift := (GetKeyState(VK_SHIFT) and 128) <> 0;
    keyCtrl := (GetKeyState(VK_CONTROL) and 128) <> 0;
    msg := ISM_TMP_BRW_POPUP_BACKGROUND;
    if keyShift then
        msg := ISM_TMP_BRW_POPUP
    else
        if keyCtrl then
            msg := ISM_TMP_BRW_POPUP_BACKGROUND;
    PostTextMessage(Self.Handle, ISM_TMP_TEXT, msg, targetUrl);
    //FCore.NewWebPage(targetUrl, reCEF, True);
end;

procedure TFrmBrwChromium.BrwBeforeResourceLoad(Sender: TObject; const Browser: ICefBrowser;
    const Frame: ICefFrame; const request: ICefRequest; out Result: boolean);
var
    template: string;
begin
    LastErrorCode := 0;
    LastErrorText := '';
    if BlockContent then
        Result := IsURLBlack(request.GetUrl, template)
    else
        Result := False;
    if Result then
        Log('Block resource', request.GetUrl + ' (' + template + ')')
    else
    begin
        Log('Load resource', request.GetUrl);
        DoSetStatus(request.GetUrl);
    end;
end;

procedure TFrmBrwChromium.BrwLoadEnd(Sender: TObject; const Browser: ICefBrowser;
    const Frame: ICefFrame; httpStatusCode: integer);
begin
    DoSetStatus('Ready');
    Log('Ready');
    //Frame.GetSource();
end;

procedure TFrmBrwChromium.BrwLoadError(Sender: TObject; const Browser: ICefBrowser;
    const Frame: ICefFrame; errorCode: TCefErrorCode; const errorText, failedUrl: ustring);
var
    txt: string;
begin
    //if errorText = '' then
    //    txt := GetEnumName(TypeInfo(TCefErrorCode), Ord(errorCode))
    //else
    txt := GetCEFErrorText(errorCode);
    txt := txt + ' [' + failedUrl + '] ' + ' (' + IntToStr(integer(errorCode)) + ')';
    DoSetStatus('Error: ' + txt);
    Log('Error', txt);
    LastErrorCode := Integer(errorCode);
    LastErrorText := GetCEFErrorText(errorCode);

    //Brw.Browser.GetMainFrame.LoadString('Error: ' + txt, 'error');
end;

procedure TFrmBrwChromium.BrwLoadStart(Sender: TObject; const Browser: ICefBrowser; const Frame: ICefFrame);
begin
    DoSetStatus('Loading...');
    Log('Load start');
end;

procedure TFrmBrwChromium.BrwStatusMessage(Sender: TObject; const Browser: ICefBrowser; const Value: ustring);
begin
    DoSetHint(Value);
end;

procedure TFrmBrwChromium.BrwTitleChange(Sender: TObject;
    const Browser: ICefBrowser; const ATitle: ustring);
begin
    DoTitleChange(AnsiToUtf8(ATitle));
end;

procedure TFrmBrwChromium.BrwLoadingStateChange(Sender: TObject; const Browser: ICefBrowser;
    isLoading, canGoBack, canGoForward: boolean);
var
    url: string;
    uri: TURI;
begin
    Log('LoadingStateChange (isLoading)', isLoading);
    Log('LoadingStateChange (canGoBack)', canGoBack);
    Log('LoadingStateChange (canGoForward)', canGoForward);

    actNavBack.Enabled := canGoBack;
    actNavForward.Enabled := canGoForward;

    if isLoading then
    begin
        if not tmrProgress.Enabled then
            ProgressStart;
    end
    else
    begin
        // Parse URL and update history
        Log('Frame URL', Browser.MainFrame.Url);
        Log('Frame name', Browser.MainFrame.Name);
        Log('Title', Title);

        if Browser.HasDocument then
        begin
            // Write history
        end
        else
        begin
            // Show error
        end;
        if LastErrorCode <> 0 then
        begin
            //Browser.GetMainFrame.LoadString(GetErrorHTML(LastErrorCode, LastErrorText), 'error');
        end;

        LastErrorCode := 0;
        LastErrorText := '';
        ProgressStop;
    end;
    Exit;
    // Fix issue with action glyph
    //ilBrwBase.GetBitmap(
    //    TCustomAction(btnNavRefresh.Action).ImageIndex,
    //    btnNavRefresh.Glyph);
    //btnNavRefresh.Refresh;
end;

procedure TFrmBrwChromium.BrwProcessMessageReceived(Sender: TObject; const Browser: ICefBrowser;
    sourceProcess: TCefProcessId; const message: ICefProcessMessage; out Result: boolean);
var
    s: string;
    keyShift, keyCtrl: boolean;
begin
    Result := False;
    Log('ProcessMessageReceived', message.Name);
    if message.Name = 'navigation' then
    begin
        s := message.ArgumentList.GetString(0);
        keyShift := (GetKeyState(VK_SHIFT) and 128) <> 0;
        keyCtrl := (GetKeyState(VK_CONTROL) and 128) <> 0;
        if keyShift then
            PostTextMessage(Self.Handle, ISM_TMP_TEXT, ISM_TMP_BRW_POPUP, s)
        else if keyCtrl then
            PostTextMessage(Self.Handle, ISM_TMP_TEXT, ISM_TMP_BRW_POPUP_BACKGROUND, s)
        else
            LoadURL(s);
    end;
end;

procedure TFrmBrwChromium.BrwProtocolExecution(Sender: TObject; const Browser: ICefBrowser;
    const url: ustring; out allowOsExecution: boolean);
begin
    Log('Protocol', url);
end;

procedure TFrmBrwChromium.BrwBeforeDownload(Sender: TObject; const Browser: ICefBrowser;
    const downloadItem: ICefDownloadItem; const suggestedName: ustring; const callback: ICefBeforeDownloadCallback);
const
    cDownloadStart = 'Download start';
    aAllFilesFilter = {$ifdef WINDOWS}'*.*'{$else}'*'{$endif};
var
    tmpPath, tmpFile, tmpExt: string;
    u: TURI;

    function FileNameFormContent(const aContent: string): string;
    const
        wc: set of char = [':', '\', '/', '*', '?'];
        rc: char = '-';
    var
        i: Integer;
    begin
        Result :=
            AnsiDequotedStr(
                Copy(
                    aContent,
                    Pos('=', aContent) + 1,
                    Length(aContent)),
                '"');
        // Remove wrong characters
        for i := 1 to Length(Result) do
            if Result[i] in wc then
                Result[i] := rc;
    end;

begin
    Log(cDownloadStart, Format('CurrentSpeed %d', [downloadItem.CurrentSpeed]));
    Log(cDownloadStart, Format('PercentComplete %d', [downloadItem.PercentComplete]));
    Log(cDownloadStart, Format('TotalBytes %d', [downloadItem.TotalBytes]));
    Log(cDownloadStart, Format('ReceivedBytes %d', [downloadItem.ReceivedBytes]));
    Log(cDownloadStart, Format('StartTime %s', [DateTimeToStr(downloadItem.StartTime)]));
    Log(cDownloadStart, Format('EndTime %s', [DateTimeToStr(downloadItem.StartTime)]));
    Log(cDownloadStart, Format('FullPath %s', [downloadItem.GetFullPath]));
    Log(cDownloadStart, Format('Id %d', [downloadItem.Id]));
    Log(cDownloadStart, Format('Url %s', [downloadItem.Url]));
    Log(cDownloadStart, Format('SuggestedFileName %s', [downloadItem.SuggestedFileName]));
    Log(cDownloadStart, Format('ContentDisposition %s', [downloadItem.ContentDisposition]));
    Log(cDownloadStart, Format('MimeType %s', [downloadItem.MimeType]));

    tmpPath := IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName)) + 'tmp' + PathDelim;
    ForceDirectories(tmpPath);

    if downloadItem.MimeType = 'application/x-bittorrent' then
    begin
        tmpFile := tmpPath + FileNameFormContent(downloadItem.ContentDisposition);
        callback.Cont(tmpFile, False);
        Log('Download into', tmpFile);
    end
    else
    begin
        u := ParseURI(downloadItem.Url);
        tmpFile := u.Document;
        if tmpFile = '' then
        begin
            tmpFile := FileNameFormContent(downloadItem.ContentDisposition);
        end;

        SaveDialog.FileName := tmpFile;
        tmpExt := '*' + ExtractFileExt(tmpFile);
        SaveDialog.Filter := tmpExt + '|' + tmpExt + '|' + 'All|' + aAllFilesFilter;

        if SaveDialog.Execute then
        begin
            callback.Cont(SaveDialog.FileName, False);
        end
        else
        begin
            //callback.Cont('', False);
        end;
    end;
end;

procedure TFrmBrwChromium.BrwDownloadUpdated(Sender: TObject; const Browser: ICefBrowser;
    const downloadItem: ICefDownloadItem; const callback: ICefDownloadItemCallback);
var
    s: string;
begin
    s := Format(
            'Speed %d, Complete %d%%, Total %d, Received %d', [
                downloadItem.CurrentSpeed,
                downloadItem.PercentComplete,
                downloadItem.TotalBytes,
                downloadItem.ReceivedBytes
            ]
        );
    Log('Download', s);
    Log('Download', Format('FullPath %s', [downloadItem.GetFullPath]));
    DoSetStatus(s);

    // If download canceled
    //if downloadItem.IsCanceled then
    //begin
    //    //callback.Cancel;
    //end
    //else
    begin
        if downloadItem.MimeType = 'application/x-bittorrent' then
        begin
            if downloadItem.IsComplete then
            begin
                OpenDocument(downloadItem.FullPath);
            end;
        end;
    end;
end;

procedure TFrmBrwChromium.BrwMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: integer);
begin
    Log('MouseDown');
end;

function TFrmBrwChromium.GetBrw: TChromium;
begin
    if FBrw = nil then
        InitChromium;
    Result := FBrw;
end;

procedure TFrmBrwChromium.Init;
begin
    inherited;

    FBrw := nil;
end;

procedure TFrmBrwChromium.Done;
begin
    if Assigned(FBrw) then
    begin
        // Remove events handlers
        FBrw.OnAddressChange := nil;
        FBrw.OnBeforeResourceLoad := nil;

        FBrw.OnLoadStart := nil;
        FBrw.OnLoadEnd := nil;
        FBrw.OnLoadError := nil;

        FBrw.OnStatusMessage := nil;
        FBrw.OnTitleChange := nil;

        FBrw.OnBeforePopup := nil;

        FBrw.OnLoadingStateChange := nil;

        FBrw.OnProcessMessageReceived := nil;

        FBrw.OnProtocolExecution := nil;

        FBrw.OnBeforeDownload := nil;
        FBrw.OnDownloadUpdated := nil;

        //FBrw.Browser.GetHost.CloseBrowser(False);
    end;

    Application.ProcessMessages;
end;

procedure TFrmBrwChromium.InitChromium;
begin
    //CefRenderProcessHandler := TNDCefRenderProcessHandler.Create;
    //TNDCefRenderProcessHandler(CefRenderProcessHandler).FBrwFrame := Self;
    //CefBrowserProcessHandler := TCefBrowserProcessHandlerOwn.Create;

    FBrw := TChromium.Create(Self);
    //FBrw.Parent := pnlClient;
    FBrw.Parent := nbpPage;
    FBrw.Align := alClient;

    FBrw.OnAddressChange := @BrwAddressChange;
    FBrw.OnBeforeResourceLoad := @BrwBeforeResourceLoad;

    FBrw.OnLoadStart := @BrwLoadStart;
    FBrw.OnLoadEnd := @BrwLoadEnd;
    FBrw.OnLoadError := @BrwLoadError;

    FBrw.OnStatusMessage := @BrwStatusMessage;
    FBrw.OnTitleChange := @BrwTitleChange;

    FBrw.OnBeforePopup := @BrwBeforePopup;

    FBrw.OnLoadingStateChange := @BrwLoadingStateChange;

    FBrw.OnProcessMessageReceived := @BrwProcessMessageReceived;

    FBrw.OnProtocolExecution := @BrwProtocolExecution;

    FBrw.OnBeforeDownload := @BrwBeforeDownload;
    FBrw.OnDownloadUpdated := @BrwDownloadUpdated;

    FBrw.UserStyleSheetLocation := 'file:///C:/prg/net/Opera-64/styles/nd/korrespondent.net.css';

    FBrw.FontOptions.FixedFontFamily := 'Liberation Mono';
    //FBrw.FontOptions.StandardFontFamily := 'Liberation Sans';
    FBrw.FontOptions.SansSerifFontFamily := 'Liberation Sans';
end;

procedure TFrmBrwChromium.EventTitleChange(AFrame: TWinControl; ATitle: string);
begin

end;

procedure TFrmBrwChromium.LoadURL(const AUrl: string);
begin
    inherited;
    Brw.Load(AUrl);
end;

procedure TFrmBrwChromium.GetSource(AText: TStrings);
begin
    //Brw.Browser.;
end;

procedure TFrmBrwChromium.DoBack;
begin
    if Brw.Browser.CanGoBack then
        Brw.Browser.GoBack;
end;

procedure TFrmBrwChromium.DoForward;
begin
    if Brw.Browser.CanGoForward then
        Brw.Browser.GoForward;
end;

procedure TFrmBrwChromium.DoRefresh;
begin
    Brw.Browser.ReloadIgnoreCache;
end;

procedure TFrmBrwChromium.DoStop;
begin
    Brw.Browser.StopLoad;
end;

end.


















